perm filename SUBR4.F4[MUS,LCS] blob
sn#168155 filedate 1975-07-10 generic text, type T, neo UTF8
00100 C SUBR4.F4
00200 C THIS SUBR. ALLOWS RAND. SELECTION FROM UP TO 5 RHYTHMIC STRINGS
00300 C OF UP TO 19 UNITS EACH. (2OTH UNIT IS END MARK.)
00400
00500 SUBROUTINE SUBR
00600 COMMON /INS/ INST(27),BG(60)
00700 COMMON P(30),INUM,IPAR,CNT(27),BT,PL(48),IREST,DF,DUR(27)
00800 C INUM=INST# IPAR=PARAM#
00900 C BT=BASIC TIME P1 WHEN SUBROUTINE IS CALLED
01000 C IF IREST IS <0, THAT NOTE WILL BE A REST.
01100 C INST=INST. NAME, BG=INSTS' BEGIN TIMES.
01200 C NOTE #S IN SUBROUTINE: (1-84) C4=37 FS4=43 C5=49 ETC.
01300 C F1=86 F15=100 (NO F16!)
01400
01500 DIMENSION RH(20,5),Z(5)
01600 C SETS UP 2-DIMENSIONAL ARRAY FOR RHYTHS. Z IS FOR STORAGE.
01700
01800 J=CNT(INUM)
01900 IF(J.NE.1)GO TO 10
02000
02100 XDUR=DUR(INUM)
02200 C SAVES ORIGINAL GIVEN DURATION.
02300 DUR(INUM)=1000
02400 C SO THERE WILL BE ENOUGH ROOM FOR LAST RHYTH. STRING.
02500
02600 J2=P(2)
02700 C GETS POINTER TO 1ST RHYTH. STRING.
02800
02900 J3=P(3)
03000 C GETS BEGIN POINT OF CHROM. SCALE.
03100
03200 K=0
03300 C INITIALIZE THE COUNTER.
03400
03500 M=1
03600 C M WILL DETERMINE THE DIRECTION OF CHROM. SCALE.
03700
03800 DO 20 L=1,5
03900 20 Z(L)=0
04000 C ZERO ALL 'Z' STORAGE.
04100
04200 10 IF(J.GT.20)GO TO 1
04300 C THE FIRST 20 NOTES WILL LOAD UP THE RHYTH. STORAGE SLOTS.
04400
04500 DO 100 L=1,5
04600 IF(Z(L).GT.20)GO TO 100
04700 C LOOKS AT PREVIOUS VALUE. SKIPS IF IT WAS AN END MARK.
04800
04900 Z(L)=P(L+10)
05000 C SAVES VALUES FROM P11→P15
05100
05200 RH(J,L)=Z(L)
05300 C PUT IT AWAY
05400
05500 100 CONTINUE
05600
05700 1 K=K+1
05800 C UPDATE COUNTER
05900
06000 X=RH(K,J2)
06100 C PICKS UP RHYTHM NUMBER K.
06200
06300 IF(X.LT.20)GO TO 2
06400 C JUMP IF NOT END MARK. RHYTH VALUE OF .1=40, HENCE END MARK.
06500
06600 K=1
06700 C RESET COUNTER
06800
06900 M=-M
07000 C CHANGE THE DIRECTION OF NEXT SCALE.
07100
07200 J2=P(2)
07300 C PICK A NEW POINTER FOR RHYTH. STRINGS.
07400
07500 J3=P(3)
07600 C PICK UP NEW PITCH POINTER.
07700
07800 IF(M.LT.0)J3=J3+24
07900 C SHIFT UP 2 OCTAVES IF SCALE DIRECTION IS DOWNWARD.
08000
08100 X=RH(K,J2)
08200 C GET FIRST OF NEW STRING.
08300
08400 IF(XDUR.GT.P(1))GO TO 2
08500 C CHECK ON ORIGINAL DURATION.
08600
08700 DUR(INUM)=0
08800 C IF WE'VE PASSED ORIGINAL DUR. CAUSE ENDING NOW.
08900 X=-1
09000 C LAST 'NOTE' IS A REST.
09100
09200 2 P(2)=X
09300 C PUT RHYTH. INTO P2
09400
09500 P(3)=J3+K*M
09600 C PUT NOTE NUM INTO P3. M DETERMINES DIRECTION OF SCALE.
09700
09710 IF(M.LT.0)P(7)=88
09720 C WHEN DESCENDING, USE TOOT'S TONE.
09800 RETURN
09900 END
10000
10100
10200 C TYPICAL INPUT
10300
10400 C CLAR 0 25;
10500 C P2 1 1,5.999; <POINTERS TO RHYTH. GROUPS
10600 C P3 1 C3,C5;
10700 C P4 2000; P5 F1; P7 F4;
10800 C P11 RHY/8/4/8/.1; < .1 MAKES END MARK
10900 C P12 RHY/ 12X6/ 20X5/ 4/ .1;
11000 C P13 RHY/ 4./ 16// 8// .1;
11100 C P14 RHY/ 4/ 16/ 8X4/ 16/ 4/ .1;
11200 C P15 SUBN RHY/ 16/ -8./ 16/ -16/ REP 2 / .1;
11300 C END;
11400 C TEMPO/120;